home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.10 Oct 87 / basic source / Paint Scroll.BAS next >
Encoding:
BASIC Source File  |  1987-08-22  |  2.9 KB  |  103 lines  |  [TEXT/QEDZ]
  1. REM Paint Scroll Demo
  2. REM ©Mactutor 1987
  3. REM By Dave Kelly and Lee Bass
  4. REM Thanks Lee!!
  5. REM Adapted from E-126 of ZBasic manual
  6.  
  7. WINDOW OFF
  8. COORDINATE WINDOW
  9. DEF MOUSE=1
  10. X&=MEM(-1)
  11. DIM X%(1),71 X$(719):X%(0)=576:X%(1)=720
  12. ScrollInc=20:'Increment for moving picture
  13. WINDOW #1,"",(50,80)-(430,310),3
  14. Wptr&=WINDOW(14)
  15. GOSUB "OpenFile"
  16.  
  17. MENU 1,0,1,"File"
  18. MENU 1,1,1,"Open…/O"
  19. MENU 1,2,1,"Quit/Q"
  20. ON MENU GOSUB "MenuEvent":MENU ON:MOUSE ON
  21. "Main Program Loop"
  22. DO
  23. IF New=1 THEN PUT (-XChange,-YChange),X%(0),PSET:New=0
  24. MouseEvent=MOUSE(0):Horizpos=MOUSE(1):Vertpos=MOUSE(2)
  25. LONG IF Horizpos>0 AND Horizpos<380 AND Vertpos>0 AND Vertpos<230' in our window
  26.     LONG IF Vertpos>153:REM bottom section
  27.         IF Horizpos<127 THEN CursorNumber=264
  28.         IF Horizpos>=127 AND Horizpos<=253 THEN CursorNumber=258
  29.         IF Horizpos>253 THEN CursorNumber=263
  30.     END IF
  31.     LONG IF Vertpos>=77 AND Vertpos<=153:REM middle section
  32.         IF Horizpos<127 THEN CursorNumber=259
  33.         IF Horizpos>=127 AND Horizpos<=253 THEN CursorNumber=265
  34.         IF Horizpos>253 THEN CursorNumber=260
  35.     END IF
  36.     LONG IF Vertpos<77:REM top section
  37.         IF Horizpos<127 THEN CursorNumber=261
  38.         IF Horizpos>=127 AND Horizpos<=253 THEN CursorNumber=257
  39.         IF Horizpos>253 THEN CursorNumber=262
  40.     END IF
  41.     LONG IF MouseEvent<0:' cursor down change xx,yy to move picture
  42.         IF CursorNumber=259 THEN XChange=XChange-ScrollInc
  43.         IF CursorNumber=260 THEN XChange=XChange+ScrollInc
  44.         IF CursorNumber=257 THEN YChange=YChange-ScrollInc
  45.         IF CursorNumber=258 THEN YChange=YChange+ScrollInc
  46.         IF CursorNumber=261 THEN XChange=XChange-ScrollInc:YChange=YChange-ScrollInc
  47.         IF CursorNumber=262 THEN XChange=XChange+ScrollInc:YChange=YChange-ScrollInc
  48.         IF CursorNumber=263 THEN XChange=XChange+ScrollInc:YChange=YChange+ScrollInc
  49.         IF CursorNumber=264 THEN XChange=XChange-ScrollInc:YChange=YChange+ScrollInc
  50.         IF YChange<0 THEN YChange=0
  51.         IF XChange<0 THEN XChange=0
  52.         IF YChange>720-230 THEN YChange=720-230
  53.         IF XChange>576-380 THEN XChange=576-380
  54.         PUT (-XChange,-YChange),X%(0),PSET
  55.     END IF
  56.     MyCursor=CursorNumber:
  57.     CURSOR MyCursor
  58. XELSE
  59.     CURSOR 0:CursorNumber=0:REM Not in our window
  60. END IF
  61. UNTIL Finished=1
  62. MENU OFF:MOUSE OFF
  63. END
  64.  
  65. "MenuEvent"
  66. Menunumber=MENU(0)
  67. Menuitem=MENU(1)
  68. IF Menuitem=1 THEN GOSUB "OpenFile"
  69. IF Menuitem=2 THEN END
  70. MENU
  71. RETURN
  72.  
  73. "OpenFile"
  74. CALL HIDEWINDOW(Wptr&)
  75. WINDOW#2,"",(100,30)-(400,55),2
  76. TEXT 2,12,1
  77. LOCATE 0,0
  78. CLS LINE
  79. PRINT SPC(5);"Please Select a Paint File to View";
  80. "Load PaintPic"
  81. F$=FILES$(1,"PNTG","PNTG",V%)
  82. IF F$="" THEN CALL SHOWWINDOW(Wptr&):RETURN
  83. LOCATE 0,0
  84. CLS LINE
  85. PRINT "Now Loading ";F$;
  86. REM Read in the Paint File
  87. OPEN"I",1,F$,1,V% : S&=LOF(1):REM Set length of Paint File
  88. A&=VARPTR(A$):Y&=VARPTR(X$(0)):X&=A&:N=256
  89. FL&=S&-512:CURSOR 4:RECORD #1,512
  90. FOR I = 1 TO 720:REM Lines in the Paint Picture
  91.     LONG IF N>180
  92.         BLOCKMOVE X&,A&,256-N:X&=A&
  93.         IF N>FL& THEN NX=FL& ELSE NX=N
  94.         READ FILE #1,A&+256-N,NX:FL&=FL&-NX
  95.     END IF
  96.     CALL UNPACKBITS(X&,Y&,72):N=X&-A&
  97. NEXT
  98. CLOSE #1
  99. XChange=0:YChange=0:New=1
  100. WINDOW CLOSE 2
  101. CALL SHOWWINDOW(Wptr&)
  102. WINDOW 1
  103. RETURN